home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO003.dsk / SHAPE.GENERATOR.bas < prev    next >
BASIC Source File  |  2012-02-16  |  21KB  |  357 lines
  1. 5  HGR : TEXT : HOME 
  2. 10 A =  PEEK(104): IF A = 96  THEN 25
  3. 15  POKE 103,1: POKE 104,96: POKE 24576,0
  4. 20  PRINT  CHR$(4);"- /PRODOS.03/SHAPE.GENERATOR"
  5. 25 TA = 16384:D$ =  CHR$(4): SCALE= 1: ROT= 0
  6. 30  GOSUB 2500
  7. 35  HOME : VTAB 4: PRINT " THIS PROGRAM ALLOWS YOU TO MAKE A NEW": PRINT : PRINT " TABLE OF SHAPES,  OR EDIT AN EXISTING"
  8. 40  PRINT : PRINT " ONE.  CHOOSE 'N' OR 'L'": VTAB 12: HTAB 6: PRINT "N  --->  NEW SHAPE TABLE": VTAB 14: HTAB 6: PRINT "L  --->  LOAD EXISTING TABLE"
  9. 45  VTAB 16: HTAB 6: GET A$
  10. 50  IF A$ = "N"  THEN 140
  11. 55  IF A$ < >"L"  THEN  VTAB 16: CALL  -958: GOTO 45
  12. 60  HOME : VTAB 4: PRINT "   PLEASE TYPE THE EXACT FILE NAME OF": PRINT : PRINT "   SHAPE TABLE TO BE LOADED FROM DISK": POKE 32,9: PRINT : PRINT "( BUT NOT THE  '.SG' )"
  13. 65  VTAB 11: INPUT N$:N$ = N$ +".SG"
  14. 70  PRINT D$;"BLOAD ";N$;",A$4000"
  15. 75 N = ( PEEK(TA +2) +256 * PEEK(TA +3) -4)/2
  16. 80 SN =  PEEK(TA)
  17. 85 L =  PEEK(TA +2 +2 *SN) +256 * PEEK(TA +3 +2 *SN):F = TA +L -1
  18. 90 H =  PEEK(F -3):V =  PEEK(F -2):SX =  PEEK(F -1):SY =  PEEK(F)
  19. 95  POKE 32,9: PRINT : VTAB 17: PRINT "CAPACITY :"; TAB( 13);N; TAB( 17);"SHAPES": PRINT 
  20. 100  PRINT "IT NOW HAS:"; TAB( 13); PEEK(TA); TAB( 17);"SHAPES"
  21. 105  VTAB 24: INVERSE : PRINT " ANY KEY TO CONTINUE  ";: NORMAL 
  22. 110 A =  PEEK( -16384): IF A >127  THEN  POKE  -16368,0: GOTO 200
  23. 115  GOTO 110
  24. 140  HOME : POKE 32,9: VTAB 4: PRINT "NUMBER OF SHAPES": PRINT "  (MAXIMUM 255)": VTAB 4: HTAB 20: INPUT A$: IF  VAL(A$) <1  OR  VAL(A$) >255  THEN 140
  25. 145 N =  VAL(A$):SX = 1:SY = 1:N$ = "?"
  26. 150 A = 4 +N *2
  27. 155  POKE TA,0: POKE TA +1,0: POKE TA +2,A -( INT(A/256) *256): POKE TA +3, INT(A/256)
  28. 160  FOR I = TA +4 TO TA +3 +N *2: POKE I,0: NEXT I: GOTO 170
  29. 165  HOME : POKE 32,9: REM  START GRID CHANGE 
  30. 170  VTAB 8: PRINT "MAXIMUM WIDTH": PRINT : PRINT : PRINT "MAXIMUM HEIGHT"
  31. 175  VTAB 8: HTAB 20: INPUT H$: IF  VAL(H$) <1  OR  VAL(H$) >25  THEN 175
  32. 180  VTAB 11: HTAB 20: INPUT V$: IF  VAL(V$) <1  OR  VAL(V$) >15  THEN 180
  33. 185 H =  VAL(H$):V =  VAL(V$)
  34. 200  TEXT : POKE 32,0: HOME :A =  FRE(0): VTAB 2: PRINT "CHOOSE ONE OF THE FOLLOWING, BY NUMBER:": POKE 32,6
  35. 205  PRINT : PRINT "1   DRAW A(NOTHER) SHAPE": PRINT : PRINT "2   CHANGE SIZES OF GRID": PRINT : PRINT "3   SEE EXISTING SHAPE"
  36. 210  PRINT : PRINT "4   EDIT EXISTING SHAPE": PRINT : PRINT "5   COPY EXISTING SHAPE": PRINT : PRINT "6   MOVE EXISTING SHAPE": PRINT : PRINT "7   DELETE SHAPE"
  37. 215  PRINT : PRINT "8   SAVE SHAPE TABLE TO DISK": PRINT : PRINT "9   CHANGE CAPACITY OF TABLE": PRINT : PRINT "X   EXIT PROGRAM";: POKE 32,0
  38. 220 SA = 23456
  39. 225 A =  PEEK( -16384)
  40. 230  IF A >127  THEN 240
  41. 235  GOTO 225
  42. 240  IF A = 216  THEN  POKE  -16368,0: END 
  43. 245 A = A -176: IF A <1  OR A >9  THEN 225
  44. 250  POKE  -16368,0
  45. 255  HOME : ON A GOTO 300,165,400,500,700,900,1200,1300,1400
  46. 300 E = 0: IF  PEEK(TA) >N -1  THEN 320
  47. 305  HOME : VTAB 4: HTAB 6: PRINT "WOULD YOU LIKE TO SEE ANOTHER": PRINT : HTAB 6: PRINT "SHAPE WHILE PLOTTING <Y/N> ?";: GET A$: IF A$ < >"Y"  THEN 335
  48. 310  VTAB 10: HTAB 6: PRINT "ENTER NUMBER OF OTHER SHAPE";: INPUT SN: IF SN > PEEK(TA)  THEN 440
  49. 315  GOSUB 2000:SA = 23456:SN =  PEEK(TA) +1: GOTO 340
  50. 320  HOME : POKE 32,9: VTAB 6: PRINT "THIS TABLE IS NOW FULL;": PRINT : IF N = 255  THEN  PRINT "YOU MUST START ANOTHER,": PRINT : PRINT "OR DELETE SOME SHAPES.": PRINT : PRINT : PRINT "YOU MAY STILL EDIT THIS": PRINT : PRINT "ONE BUT DON'T FORGET TO": PRINT : PRINT "SAVE IT.": GOTO 330
  51. 325  PRINT "YOU MAY INCREASE IT, UP": PRINT : PRINT "TO A MAX. OF 255 SHAPES": PRINT : PRINT : PRINT : HTAB 5: PRINT "SELECT ITEM  9": PRINT : HTAB 5: PRINT "FROM MAIN MENU"
  52. 330  VTAB 23: INVERSE : PRINT "  ANY KEY TO CONTINUE  ";: NORMAL : GOTO 110
  53. 335  GOSUB 1600
  54. 340 SN =  PEEK(TA) +1
  55. 345 SB =  PEEK(TA +SN *2) +256 * PEEK(TA +SN *2 +1) +TA
  56. 350  HCOLOR= 3: GOSUB 1920: GOSUB 1700
  57. 355  HOME : VTAB 21: PRINT "<Y>       TO SAVE THIS AS SHAPE # ";SN: PRINT "<R>       TO REJECT IT,": PRINT : PRINT "<OTHER>   TO SEE IT      (REAL SIZE)";
  58. 360  POKE TA,SN: VTAB 24: HTAB 40: GET M$
  59. 365  IF M$ = "Y"  THEN L = SB -TA:F = SB -1: POKE (TA +2 +SN *2),(L -256 * INT(L/256)): POKE (TA +3 +SN *2), INT(L/256): TEXT : HOME : GOTO 95
  60. 370  IF M$ = "R"  THEN  POKE TA,SN -1: GOTO 200
  61. 375  GOSUB 1650: GOTO 355
  62. 400 E =  -1: HOME : CALL 62450: VTAB 4: HTAB 8: PRINT "SHAPE # TO BE VIEWED";: HTAB 30: INPUT SN: IF SN > PEEK(TA)  THEN E = 0: GOTO 440
  63. 405  HCOLOR= 6: GOSUB 2000: GOSUB 1650
  64. 410  PRINT : VTAB 21: HTAB 12: PRINT "THIS IS SHAPE # ";SN: PRINT : PRINT "SEE ANOTHER? <Y/N> OR <RETURN> FOR NEXT";: GET A$
  65. 415  IF A$ = "N"  THEN E = 0: GOTO 200
  66. 420  HOME : CALL 62450:E =  -2: IF A$ =  CHR$(13)  THEN SN = SN +1: GOTO 430
  67. 425  VTAB 22: HTAB 14: PRINT "NEXT SHAPE # ";: INPUT SN
  68. 430  IF SN > PEEK(TA)  THEN  TEXT :E = 0: GOTO 440
  69. 435  HCOLOR= 6: GOSUB 2000: GOSUB 1665: GOTO 410
  70. 440  POKE 32,7: VTAB 13: PRINT "THERE ISN'T ANY SHAPE #";SN: VTAB 24: INVERSE : PRINT "   ANY KEY TO CONTINUE   ";: NORMAL : GOTO 110
  71. 500  HOME : VTAB 4: HTAB 8: PRINT "SHAPE # TO BE EDITED";: HTAB 30: INPUT SN: IF SN > PEEK(TA)  THEN 440
  72. 505  HCOLOR= 6:E = SN +1
  73. 510  GOSUB 2000
  74. 515  HCOLOR= 7:SB = 2048
  75. 520  PRINT : VTAB 21: PRINT "TOUCH <RETURNS> WHERE UNCHANGED, OR <S>": PRINT : PRINT "TO CHANGE START, THEN I/J/K/M,Z TO END";
  76. 525 SA = 23456:X = XO:Y = YO: XDRAW 1 AT X,Y
  77. 530  GET M$: IF M$ < >"S"  THEN 550
  78. 535  GOSUB 1900: DRAW 1 AT X,Y: VTAB 23: HTAB 39: GET M$: IF M$ = "S"  THEN 535
  79. 540  GOTO 550
  80. 545  VTAB 23: HTAB 39: GET M$
  81. 550  IF M$ =  CHR$(13)  THEN 570
  82. 555  IF M$ = "U"  THEN  XDRAW 1 AT X,Y: GOSUB 2410: XDRAW 1 AT X,Y: GOTO 545
  83. 560  IF (M$ = "I") +(M$ = "J") +(M$ = "K") +(M$ = "M") +(M$ = "Z") +(M$ = "G") +(M$ = "Q") = 1  THEN 615
  84. 565  GOTO 545
  85. 570 M =  PEEK(SA): IF M = 255  THEN 585
  86. 575  XDRAW 1 AT X,Y: IF M >3  THEN M = M -4
  87. 580  GOSUB 2065: XDRAW 1 AT X,Y: GOTO 545
  88. 585  HOME : VTAB 22: PRINT "SHAPE TO REMAIN UNCHANGED?  <Y/N>     ";: GET A$
  89. 590  IF A$ = "Y"  THEN 200
  90. 595  IF A$ = "N"  THEN  PRINT : VTAB 24: PRINT "EDIT FROM START <RETURN> OR END <U> ?";: GET M$
  91. 600  IF M$ =  CHR$(13)  THEN 510
  92. 605  IF M$ = "U"  THEN  HOME : GOTO 560
  93. 610  GOTO 595
  94. 615 X = XO:Y = YO
  95. 620  FOR I = 23456 TO SA -1:M =  PEEK(I): IF M >3  THEN  DRAW 2 AT X,Y:M = M -4
  96. 625  GOSUB 2065:SA = SA -1: NEXT I
  97. 630 E = 0: HCOLOR= 0: DRAW 2 AT X,Y: HCOLOR= 3: HOME : GOSUB 1930: GOSUB 1735: GOTO 2100
  98. 700  HOME : TEXT : POKE 32,7
  99. 705  VTAB 6: PRINT "COPY FROM THIS TABLE <Y/N> ?";: GET A$: IF A$ < >"Y"  THEN 800
  100. 710  VTAB 9: PRINT : PRINT "SHAPE # TO BE COPIED";: HTAB 23: INPUT SN: IF SN <1  OR SN > PEEK(TA)  THEN 710
  101. 715  PRINT : PRINT "SEE SHAPE BEFORE COPYING ?";: GET A$: IF A$ < >"N"  THEN  GOSUB 2000: POKE 32,0: VTAB 22: HTAB 5: PRINT "IS THIS THE SHAPE TO BE COPIED ?";: GET A$: IF A$ = "N"  THEN 700
  102. 720 TE = TA
  103. 725 S = TE +2 *SN:SL =  PEEK(S):SH = 64 -E + PEEK(S +1):RL =  PEEK(S +2) -1:RH = 64 -E + PEEK(S +3): IF RL <0  THEN RL = 255:RH = RH -1
  104. 730 D = TA +2 * PEEK(TA) +2:DL =  PEEK(D):DH = 64 + PEEK(D +1)
  105. 735  POKE 60,SL: POKE 61,SH: POKE 62,RL: POKE 63,RH: POKE 66,DL: POKE 67,DH: CALL 842
  106. 740 LS = RL -SL +256 *(RH -SH) +1:DL = DL +LS:DH = DH -64
  107. 745  IF DL >255  THEN DL = DL -256:DH = DH +1: GOTO 745
  108. 750  POKE D +2,DL: POKE D +3,DH:L = L +LS: POKE TA,( PEEK(TA) +1)
  109. 755  HOME : TEXT : VTAB 4: HTAB 8: PRINT "COPY ANOTHER <Y/N> ?";: GET A$: IF A$ = "Y"  THEN 710
  110. 760  GOTO 200
  111. 800  HOME : POKE 32,7: VTAB 4: PRINT "ENTER NAME OF OTHER TABLE?": PRINT "    (MUST HAVE THE '.SG'": PRINT "    BUT DON'T TYPE IT)": PRINT : PRINT : INPUT NO$:NO$ = NO$ +".SG"
  112. 805  PRINT D$;"BLOAD ";NO$;",A$800"
  113. 810 TE = 2048: VTAB 12: PRINT "THIS TABLE HAS"; TAB( 17); PEEK(TE); TAB( 21);"SHAPES"
  114. 815  VTAB 15: PRINT "SHAPE # TO BE COPIED";: HTAB 23: INPUT SN: IF SN <1  OR SN > PEEK(TE)  THEN 815
  115. 820  PRINT : PRINT "SEE SHAPE BEFORE COPYING ?";: GET A$: IF A$ = "N"  THEN 835
  116. 825 TA = TE: GOSUB 2000: POKE 32,0: VTAB 22: HTAB 5: PRINT "IS THIS THE SHAPE TO BE COPIED ?";: GET A$: IF A$ = "N"  THEN  HOME : TEXT : GOTO 815
  117. 830 TA = 16384
  118. 835 E = 56: GOTO 725
  119. 900  HOME : VTAB 4: HTAB 17: FLASH : PRINT " WARNING ": NORMAL : PRINT : PRINT "IF YOU MOVE ANY SHAPE, ALL OTHER SHAPES": PRINT : PRINT "BETWEEN THE OLD AND NEW POSITIONS, WILL"
  120. 905  PRINT : PRINT "BE RENUMBERED. PROGRAMS USING THEM MUST": PRINT : HTAB 8: PRINT "BE ADJUSTED AS NECESSARY."
  121. 910  VTAB 16: HTAB 8: PRINT "SHAPE # TO BE MOVED";: HTAB 30: INPUT SN: IF SN > PEEK(TA)  THEN 910
  122. 915  IF SN <1  THEN 200
  123. 920  PRINT : HTAB 8: PRINT "PUT SHAPE #";SN;" AFTER # ";: INPUT SO
  124. 925  IF SO = SN  OR SO = SN -1  THEN 200
  125. 930  IF SO > PEEK(TA)  THEN SO =  PEEK(TA)
  126. 935 D = TA +2 *SN:E = TA +2 *SO +2
  127. 940  IF SN >SO  THEN 1000
  128. 945 SL =  PEEK(D +2):SH =  PEEK(D +3) +64:RL =  PEEK(E) -1:RH =  PEEK(E +1) +64:DL = 0:DH = 8
  129. 950  GOSUB 1100: GOSUB 1125: GOSUB 1150
  130. 955 LL =  PEEK(E) -1 -SL +256 *( PEEK(E +1) +64 -SH):R = LL +2048:RL = (R -256 * INT(R/256)):RH =  INT(R/256)
  131. 960  GOSUB 1175
  132. 965  FOR I = D +2 TO E -2  STEP 2
  133. 970 AL =  PEEK(I +2) -LS:AH =  PEEK(I +3)
  134. 975  IF AL <0  THEN AL = AL +256:AH = AH -1: GOTO 975
  135. 980  POKE I,AL: POKE I +1,AH
  136. 985  NEXT I
  137. 990 E = 0: GOTO 200
  138. 1000 DL = 0:DH = 8: GOSUB 1150: GOSUB 1125
  139. 1005 SL =  PEEK(E):SH =  PEEK(E +1) +64:RL =  PEEK(D) -1:RH =  PEEK(D +1) +64: GOSUB 1100
  140. 1010 LL =  PEEK(D +2) -1 -SL +256 *( PEEK(D +3) +64 -SH):R = LL +2048:RL = (R -256 * INT(R/256)):RH =  INT(R/256)
  141. 1015  GOSUB 1175
  142. 1020  FOR I = D TO E +2  STEP  -2
  143. 1025 AL =  PEEK(I -2) +LS:AH =  PEEK(I -1)
  144. 1030  IF AL >255  THEN AL = AL -256:AH = AH +1: GOTO 1030
  145. 1035  POKE I,AL: POKE I +1,AH
  146. 1040  NEXT I
  147. 1045 E = 0: GOTO 200
  148. 1100  IF RL <0  THEN RL = RL +256:RH = RH -1
  149. 1105  GOSUB 2200
  150. 1110  RETURN 
  151. 1125 DL = RL -SL +1:DH = 8 +RH -SH
  152. 1130  IF DL >255  THEN DL = DL -256:DH = DH +1: GOTO 1130
  153. 1135  IF DL <0  THEN DL = DL +256:DH = DH -1: GOTO 1135
  154. 1140  RETURN 
  155. 1150 SL =  PEEK(D):SH =  PEEK(D +1) +64:RL =  PEEK(D +2) -1:RH =  PEEK(D +3) +64
  156. 1155  GOSUB 1100
  157. 1160 LS = RL -SL +256 *(RH -SH) +1
  158. 1165  RETURN 
  159. 1175 DL = SL:DH = SH:SL = 0:SH = 8: GOSUB 2200
  160. 1180  RETURN 
  161. 1200  HOME : VTAB 4: HTAB 17: FLASH : PRINT " WARNING ": NORMAL : PRINT : PRINT "IF YOU DELETE 1 OR MORE SHAPES, ALL THE": PRINT : PRINT "SHAPES AFTER IT/THEM IN THE TABLE, WILL"
  162. 1205  PRINT : PRINT "BE RENUMBERED. PROGRAMS USING THEM MUST": PRINT : HTAB 8: PRINT "BE ADJUSTED AS NECESSARY."
  163. 1210  VTAB 16: PRINT "WHICH SHAPE NUMBER IS TO BE DELETED   ?": PRINT : HTAB 8: PRINT "<0> IF NONE";: HTAB 30: INPUT SN
  164. 1215  IF SN = 0  THEN 200
  165. 1220  IF SN <1  OR SN > PEEK(TA)  THEN 1210
  166. 1225  HCOLOR= 3: GOSUB 2000: VTAB 21: HTAB 15: PRINT "SHAPE NO. ";SN: PRINT : PRINT "IS THIS THE SHAPE TO BE DELETED  <Y/N> ?";
  167. 1230  VTAB 23: HTAB 40: GET A$: IF A$ = "Y"  THEN 1240
  168. 1235  GOTO 200
  169. 1240 E = SN +1
  170. 1245 SL =  PEEK(TA +2 *E):SH = (64 + PEEK(TA +2 *E +1))
  171. 1250 DL =  PEEK(TA +2 *SN):DH = (64 + PEEK(TA +2 *SN +1))
  172. 1255 R = TA +L -1:RL = (R -256 * INT(R/256)):RH =  INT(R/256): GOSUB 2200
  173. 1260 T = SL -DL +256 *(SH -DH)
  174. 1265  FOR I = (TA +2 *SN) TO (TA +2 * PEEK(TA))  STEP 2
  175. 1270 A =  PEEK(I +2) -T
  176. 1275  IF A <0  THEN  POKE (I +1),( PEEK(I +1) -1):A = A +256: GOTO 1275
  177. 1280  POKE I,A: NEXT I
  178. 1285  POKE TA,( PEEK(TA) -1): POKE (TA +2 * PEEK(TA) +4),0:L = L -T:F = F -T
  179. 1290  TEXT : HOME : GOTO 95
  180. 1300  HOME : IF N$ = "?"  THEN 1320
  181. 1305  VTAB 4: PRINT "  THE TABLE BEFORE EDITING WAS NAMED:": VTAB 6: HTAB (38 - LEN(N$)): PRINT N$
  182. 1310  VTAB 8: PRINT "  SAVE AS SAME <Y> OR NEW NAME <N>  ?": VTAB 8: HTAB 37: GET A$: PRINT 
  183. 1315  IF A$ < >"N"  THEN 1325
  184. 1320  VTAB 10: PRINT "  NEW NAME ?  (PROGRAM WILL ADD '.SG')": VTAB 12: HTAB 10: INPUT N$:N$ = N$ +".SG"
  185. 1325  VTAB 14: HTAB 1: PRINT D$;"BSAVE ";N$;",A$4000,L";L
  186. 1330  VTAB 14: PRINT "  TABLE HAS NOW BEEN SAVED AND NAMED:"
  187. 1335  VTAB 16: HTAB (38 - LEN(N$)): PRINT N$
  188. 1340  VTAB 18: PRINT "  LENGTH OF THIS TABLE IS:";: HTAB (32 - LEN( STR$(L))): PRINT L;" BYTES"
  189. 1345  VTAB 24: HTAB 11: INVERSE : PRINT " ANY KEY TO CONTINUE ";: NORMAL 
  190. 1350 A =  PEEK( -16384): IF A >127  THEN  POKE  -16368,0: GOTO 1360
  191. 1355  GOTO 1350
  192. 1360  HOME : VTAB 7: HTAB 10: PRINT "CHOOSE ONE BY NUMBER :-": POKE 32,4: VTAB 11: PRINT "1  --->  MAKE OR EDIT ANOTHER TABLE": PRINT : PRINT "2  --->  USE 'SG.CONVERTER'": PRINT : PRINT "3  --->  EXIT PROGRAM"
  193. 1365 A =  PEEK( -16384): IF A >127  THEN 1375
  194. 1370  GOTO 1365
  195. 1375 A = A -176: IF A <1  OR A >3  THEN 1365
  196. 1380  POKE  -16368,0: IF A = 3  THEN  END 
  197. 1385  IF A = 2  THEN  PRINT D$;"RUN SG.CONVERTER"
  198. 1390  GOTO 30
  199. 1400  HOME : POKE 32,7: VTAB 4: PRINT "HOW MANY MORE SHAPES?": PRINT : PRINT "USE '-' SIGN FOR REDUCTION":SN =  PEEK(TA): VTAB 4: HTAB 25: INPUT T
  200. 1405  IF T <SN -N  THEN 1430
  201. 1410  IF (N +T) <256  THEN 1440
  202. 1415  POKE 32,2: VTAB 7: PRINT "MAX. NUMBER IS 255; DO YOU WANT TO:": POKE 32,6: PRINT : PRINT "- INCREASE SIZE TO 255  <Y>": PRINT : PRINT "- LEAVE AT PRESENT SIZE <N>   ";: GET A$
  203. 1420  IF A$ = "Y"  THEN T = 255 -N: GOTO 1440
  204. 1425  GOTO 200
  205. 1430  PRINT : VTAB 9: PRINT "THAT WILL DESTROY THE LAST": PRINT : PRINT (SN -N -T);: HTAB 4: PRINT "SHAPES OF THE TABLE! IS": PRINT : PRINT "THAT WHAT YOU WANT <Y/N> ?";: HTAB 26: GET A$: IF A$ = "Y"  THEN  POKE TA,(N +T): GOTO 1440
  206. 1435  GOTO 1400
  207. 1440 R = TA +L -1:RL = (R -256 * INT(R/256)):RH =  INT(R/256):SL =  PEEK(TA +2):SH = 64 + PEEK(TA +3):S = SL +256 *SH:DL = 0:DH = 8: GOSUB 2200
  208. 1445 SL = 0:SH = 8:Q = R -S:R = 2048 +Q:RL = (R -256 * INT(R/256)):RH =  INT(R/256):N = N +T:D = (TA +4 +N *2):DL = D -256 * INT(D/256):DH =  INT(D/256): GOSUB 2200
  209. 1450 E = 0:T = T *2:SN = 0: GOSUB 2300
  210. 1455 L = Q +D -TA:F = TA +L
  211. 1460  FOR I = S TO (D -1): POKE I,0: NEXT 
  212. 1465  GOTO 95
  213. 1500  HCOLOR= 6: HOME 
  214. 1505  VTAB 22: HTAB 1: PRINT "WHICH SIDE TO BE INCREASED? <I/J/K/M>";: HTAB 40: GET A$
  215. 1510  IF A$ = "I"  THEN 1535
  216. 1515  IF A$ = "M"  THEN 1545
  217. 1520  IF A$ = "J"  THEN 1555
  218. 1525  IF A$ = "K"  THEN 1565
  219. 1530  GOTO 1505
  220. 1535 V = V +1: IF V >15  THEN V = V -1: GOTO 1575
  221. 1540  FOR I = XH TO XH +H *10  STEP 10: HPLOT I,(YV -V *10): NEXT : GOTO 1580
  222. 1545 V = V +1: IF V >15  THEN V = V -1: GOTO 1575
  223. 1550 SY = SY +1:YV = YV +10: FOR I = XH TO XH +H *10  STEP 10: HPLOT I,YV: NEXT : GOTO 1580
  224. 1555 H = H +1: IF H >25  THEN H = H -1: GOTO 1575
  225. 1560 SX = SX +1:XH = XH -10: FOR I = YV TO (YV -V *10)  STEP  -10: HPLOT XH,I: NEXT : GOTO 1580
  226. 1565 H = H +1: IF H >25  THEN H = H -1: GOTO 1575
  227. 1570  FOR I = YV TO YV -V *10  STEP  -10: HPLOT (XH +H *10),I: NEXT : GOTO 1580
  228. 1575  VTAB 24: PRINT "MAX GRID IS 25*15 - NO INCREASE THAT WAY";: FOR I = 1 TO 2500: NEXT I: VTAB 23: CALL  -958
  229. 1580  VTAB 21: CALL  -958: PRINT : PRINT "ANY MORE INCREASE?";: HTAB 40: GET A$
  230. 1585  IF A$ = "Y"  THEN  VTAB 21: CALL  -958: GOTO 1505
  231. 1590  HCOLOR= 3: HOME : GOSUB 1930: RETURN 
  232. 1600  HCOLOR= 6: IF E > -1  THEN  HGR : REM   DRAW BLUE GRID 
  233. 1605 XH = (14 - INT(H/2)) *10:YV = 80 + INT(V/2) *10: FOR X = XH TO XH +(H *10)  STEP 10: FOR Y = YV TO (YV -V *10)  STEP  -10: HPLOT X,Y: NEXT Y,X
  234. 1610  RETURN 
  235. 1650  HOME : POKE  -16303,0: VTAB 4: PRINT "  WHEN YOU TOUCH ANY KEY YOU WILL SEE": PRINT : PRINT "  4 REAL-SIZE PLOTS OF THE SHAPE JUST": PRINT : PRINT "  DRAWN :-"
  236. 1655  POKE 32,5: PRINT : PRINT "1 & 2 USE COLOURS 1, 2, 3": PRINT : PRINT "3 & 4 USE COLOURS 5, 6, 7": PRINT : PRINT "1 & 3 HAVE START ON ODD NUMBER": PRINT : PRINT "2 & 4 HAVE START ON EVEN": POKE 32,0
  237. 1660  PRINT : PRINT : PRINT "  AFTER REVIEWING TOUCH ANY KEY AGAIN": PRINT : PRINT "  TO CONTINUE."
  238. 1665  HCOLOR= 0: FOR I = 160 TO 191: HPLOT 1,I TO 279,I: NEXT I: POKE 233,64
  239. 1670  HCOLOR= 7: DRAW SN AT 180,175: DRAW SN AT 221,175
  240. 1675  HCOLOR= 3: DRAW SN AT 50,175: DRAW SN AT 91,175
  241. 1680  VTAB 24: HTAB 20: IF E > -2  THEN  GET A$
  242. 1685  POKE  -16297,0: POKE  -16302,0: POKE  -16304,0: POKE 233,3
  243. 1690  GET A$: POKE  -16301,0: RETURN 
  244. 1700  XDRAW 1 AT X,Y
  245. 1705  VTAB 24: HTAB 40: GET M$: IF (M$ = "Z") +(M$ = "U") +(M$ = "I") +(M$ = "J") +(M$ = "K") +(M$ = "M") +(M$ = "Q") = 1  THEN 1720
  246. 1710  IF M$ = "S"  THEN  GOSUB 1900: GOTO 1700
  247. 1715  GOTO 1705
  248. 1720  VTAB 21: HTAB 1: CALL  -868: GOTO 1730
  249. 1725  XDRAW 1 AT X,Y: VTAB 24: HTAB 40: GET M$
  250. 1730  XDRAW 1 AT X,Y
  251. 1735  IF M$ = "Q"  THEN  POKE SA,P: POKE SA +1,255: GOTO 1790
  252. 1740  IF M$ = "U"  THEN  GOSUB 2405: GOTO 1725
  253. 1745  IF M$ = "G"  THEN  GOSUB 1500: GOTO 1725
  254. 1750  IF M$ = "Z"  THEN P = 4: DRAW 2 AT X,Y: GOTO 1725
  255. 1755  IF M$ = "I"  THEN M = P:Y = Y -10: IF Y <YV -(V *10)  THEN Y = Y +10: PRINT  CHR$(7);:M =  -1
  256. 1760  IF M$ = "K"  THEN M = P +1:X = X +10: IF X >XH +(H *10)  THEN X = X -10: PRINT  CHR$(7);:M =  -1
  257. 1765  IF M$ = "M"  THEN M = P +2:Y = Y +10: IF Y >YV  THEN Y = Y -10: PRINT  CHR$(7);:M =  -1
  258. 1770  IF M$ = "J"  THEN M = P +3:X = X -10: IF X <XH  THEN X = X +10: PRINT  CHR$(7);:M =  -1
  259. 1775  IF M =  -1  THEN 1725
  260. 1780  POKE SA,M:SA = SA +1
  261. 1785 P = 0:M =  -1: GOTO 1725
  262. 1790 SA = 23456: IF P = 4  THEN Y = Y -10
  263. 1795 B1 =  PEEK(SA): IF B1 = 255  THEN  POKE SB,0:SB = SB +1: GOTO 1860
  264. 1800 B2 =  PEEK(SA +1): IF B2 = 255  THEN  POKE SB,B1: POKE SB +1,0:SB = SB +2: GOTO 1860
  265. 1805 B3 =  PEEK(SA +2): IF B3 = 255  THEN  POKE SB,B1 +8 *B2: POKE SB +1,0:SB = SB +2: GOTO 1860
  266. 1810 B = B1 +8 *B2 +64 *B3
  267. 1815  IF B = 0  THEN  POKE SB,64: POKE SB +1,24:SB = SB +1:SA = SA +2: GOTO 1855
  268. 1820  IF B <8  THEN  POKE SB,B: GOTO 1855
  269. 1825  IF B <64  THEN  POKE SB,B:SA = SA +1: GOTO 1855
  270. 1830  IF B <256  THEN  POKE SB,B:SA = SA +2: GOTO 1855
  271. 1835 B = B -64 *B3
  272. 1840  IF B = 0  THEN  POKE SB,64: POKE SB +1,3:SB = SB +1:SA = SA +1: GOTO 1855
  273. 1845  IF B <8  THEN  POKE SB,B: GOTO 1855
  274. 1850  POKE SB,B:SA = SA +1
  275. 1855 SB = SB +1:SA = SA +1: GOTO 1795
  276. 1860  POKE SB,H: POKE SB +1,V: POKE SB +2,SX: POKE SB +3,SY:SB = SB +4
  277. 1865  RETURN 
  278. 1900  HOME : REM CHANGE START PT.
  279. 1905  VTAB 21: PRINT " INPUT <HORIZ , VERT> FROM BOTTOM LEFT": VTAB 23: HTAB 19: INPUT SX,SY
  280. 1910  IF SX <1  OR SX >H  OR SY <1  OR SY >V  THEN 1905
  281. 1915  XDRAW 1 AT X,Y
  282. 1920 X = XH +10 *SX -5:Y = YV -10 *SY +5:P = 0:M =  -1
  283. 1925  HOME : VTAB 21: INVERSE : PRINT "           CHANGE START  <S>            ": NORMAL 
  284. 1930  VTAB 22: PRINT "PLOT <Z>, UNPLOT <U>,     MOVE <I/J/K/M>"
  285. 1935  VTAB 24: PRINT "QUIT <Q>, INCREASE GRID <G>,"; TAB( 34 - LEN( STR$(SN) + STR$(N)));"# ";SN;" OF ";N;
  286. 1940  RETURN 
  287. 2000 SA = 23456:SB =  PEEK(TA +SN *2) +256 * PEEK(TA +SN *2 +1) +TA
  288. 2005 A =  PEEK(TA +(SN +1) *2) +256 * PEEK(TA +(SN +1) *2 +1) +TA:H =  PEEK(A -4):V =  PEEK(A -3):SX =  PEEK(A -2):SY =  PEEK(A -1)
  289. 2010 B =  PEEK(SB): IF B = 0  THEN  POKE SA,255: GOTO 2045
  290. 2015 B1 = B -( INT(B/8) *8): POKE SA,B1:SA = SA +1
  291. 2020  IF B -B1 = 0  THEN 2040
  292. 2025 B2 =  INT((B - INT(B/64) *64)/8): POKE SA,B2:SA = SA +1
  293. 2030  IF B -(B1 +B2 *8) = 0  THEN 2040
  294. 2035 B3 =  INT(B/64): POKE SA,B3:SA = SA +1
  295. 2040 SB = SB +1: GOTO 2010
  296. 2045  GOSUB 1600:SA = 23456: HCOLOR= 3:X = XH +10 *SX -5:Y = YV -10 *SY +5:XO = X:YO = Y
  297. 2050 M =  PEEK(SA): IF M = 255  THEN  RETURN 
  298. 2055  IF M >3  THEN  DRAW 3 AT X,Y:M = M -4
  299. 2060  GOSUB 2065: GOTO 2050
  300. 2065  IF M = 0  THEN Y = Y -10: GOTO 2085
  301. 2070  IF M = 1  THEN X = X +10: GOTO 2085
  302. 2075  IF M = 2  THEN Y = Y +10: GOTO 2085
  303. 2080 X = X -10
  304. 2085 SA = SA +1: RETURN 
  305. 2100  REM ADJUST FOR EDITED SHAPE
  306. 2105 SL =  PEEK(TA +2 *(SN +1)):SH = (64 + PEEK(TA +2 *(SN +1) +1)):S = SL +256 *SH
  307. 2110 D = ( PEEK(TA +2 *SN) +256 *( PEEK(TA +2 *SN +1)) +TA)
  308. 2115 T = (SB -2048) -(S -D)
  309. 2120 DL = SB -256 * INT(SB/256):DH =  INT(SB/256)
  310. 2125 R = TA +L:RL = (R -256 * INT(R/256)):RH =  INT(R/256)
  311. 2130  GOSUB 2200
  312. 2135 DL =  PEEK(TA +2 *SN):DH = ( PEEK(TA +2 *SN +1) +64):SL = 0:SH = 8
  313. 2140 R = SB +R -S:RL = (R -256 * INT(R/256)):RH =  INT(R/256): GOSUB 2200
  314. 2145 S = ( PEEK(TA +2) +256 * PEEK(TA +3) +TA)
  315. 2150  GOSUB 2300
  316. 2155 L = R -2048 +D -TA:F = TA +L -1: GOTO 200
  317. 2200  POKE 60,SL: POKE 61,SH
  318. 2205  POKE 62,RL: POKE 63,RH
  319. 2210  POKE 66,DL: POKE 67,DH
  320. 2215  CALL 842
  321. 2220  RETURN 
  322. 2300  FOR I = (TA +2 *(SN +1)) TO (TA +2 *( PEEK(TA) +1))  STEP 2
  323. 2305 A =  PEEK(I) +T
  324. 2310  IF A >255  THEN  POKE (I +1),( PEEK(I +1) +1):A = A -256: GOTO 2310
  325. 2315  IF A <0  THEN  POKE (I +1),( PEEK(I +1) -1):A = A +256: GOTO 2315
  326. 2320  POKE I,A: NEXT I
  327. 2325  RETURN 
  328. 2400  REM  UNPLOT ROUTINE
  329. 2405  IF P = 4  AND M =  -1  THEN 2445
  330. 2410 P = 0:SA = SA -1: IF SA = 23455  THEN M =  -1:SA = SA +1: RETURN 
  331. 2415 M =  PEEK(SA): IF M >3  THEN P = 4:M = M -4
  332. 2420  IF M = 0  THEN Y = Y +10
  333. 2425  IF M = 1  THEN X = X -10
  334. 2430  IF M = 2  THEN Y = Y -10
  335. 2435  IF M = 3  THEN X = X +10
  336. 2440  IF E >0  THEN 2450
  337. 2445  IF P = 4  THEN  HCOLOR= 0: DRAW 2 AT X,Y: HCOLOR= 3: DRAW 4 AT X,Y
  338. 2450 P = 0:M =  -1: RETURN 
  339. 2500  REM  INTERNAL SHAPE ROUTINE
  340. 2505  POKE 232,0: POKE 233,3
  341. 2510  FOR I = 768 TO 846
  342. 2515  READ J: POKE I,J: NEXT 
  343. 2520  RESTORE : RETURN 
  344. 2525  DATA  04,00,10,00,16,00,42,00,60,00,39,45,54,63,04,00,63,39,45,45,37,63,63,39,45,45,45,54,54,54,39,36,55,54,63,63,44,45,60,63,04,00,35,36,31,54,54,54,13,36,13,36,36,13,54,54,54,31,36,00,219,36,108,13,13,54,54,54,31,31,31,36,04,00
  345. 2530  DATA  160,0,76,44,254
  346. 2999  REM 
  347. 3000  REM **********************
  348. 3001  REM *                    *
  349. 3002  REM *  SHAPE  GENERATOR  *
  350. 3003  REM *                    *
  351. 3004  REM * BY ALASTAIR SPEIRS *
  352. 3005  REM *                    *
  353. 3006  REM *   DEVELOPED FROM   *
  354. 3007  REM *    A PROGRAM BY    *
  355. 3008  REM *    ROY E. MYERS    *
  356. 3009  REM *                    *
  357. 3010  REM **********************